Figure 01

Chapter 1

## Warning: `includeHTML()` was provided a `path` that appears to be a complete HTML document.
## ✖ Path: /Users/kgurashi/GitHub/2024__CRM__BP-CMML_Manuscript/Scripts/Figure_01/Panel_A.html
## ℹ Use `tags$iframe()` to include an HTML document. You can either ensure `path` is accessible in your app or document (see e.g. `shiny::addResourcePath()`) and pass the relative path to the `src` argument. Or you can read the contents of `path` and pass the contents to `srcdoc`.
Figure 01 - Panel A

Figure 01 - Panel A

1) Setup

- Defining work directory

In this section, we define the working directory for the R Markdown document.

# Get the path of the current script
# Then get the parent directory of the parent directory of the parent directory
local_wd_folder <- dirname(dirname(dirname(rstudioapi::getSourceEditorContext()$path)))

# Set the root directory for knitr to the local working directory
knitr::opts_knit$set(root.dir = local_wd_folder)

- Defining input data and output directories

Here, we define the directories for input data and output files.

# Get the directory of the current script
script_folder <- dirname(rstudioapi::getSourceEditorContext()$path)

# Define the data folder and output folder
data_folder <- './Data/Figure_01'
output_folder <- './Figures/Figure_01'

- Setting seed

Setting a seed ensures that any random processes are reproducible.

# Set a seed for reproducibility
set.seed(123)

- Packages installation (optional)

In this section, we ensure that all necessary packages are installed.

# Ensure BiocManager is available for installation of Bioconductor packages
if (!requireNamespace("BiocManager", quietly = TRUE)) install.packages("BiocManager")

# Define a list of required packages used in this script
packages_required <- c("ComplexHeatmap", "stringr", 
                        "unikn", "RColorBrewer", "yarrr", 
                        "scales", "ggsci")

# Identify any required packages that are not installed
packages_uninstalled <- packages_required[!(packages_required %in% installed.packages()[,"Package"])]

# Install any uninstalled packages
if(length(packages_uninstalled)) BiocManager::install(packages_uninstalled)

- Loading packages

Here, we load the necessary packages for our analysis.

# Load stringr for string manipulation
library(stringr, quietly = TRUE)

# Load ComplexHeatmap for creating complex heatmaps
library(ComplexHeatmap, quietly = TRUE)

- Loading palettes

In this section, we load additional color palettes and define some custom ones.

# Load additional colour palette packages
library(unikn, quietly = TRUE)
library(RColorBrewer, quietly = TRUE)
library(yarrr, quietly = TRUE)
library(scales, quietly = TRUE)
library(ggsci, quietly = TRUE)

# Define a set of custom color palettes from the unikn package
mix_1 <- usecol(pal = c(Karpfenblau, "white", Peach), n = 15)
mix_2 <- usecol(pal = c(rev(pal_seeblau), "white", pal_pinky))
mix_3 <- usecol(pal = c(rev(pal_bordeaux), "white", pal_petrol), n = 15)

# Display the custom palettes
seecol(list(mix_1, mix_2, mix_3), col_brd = "white", lwd_brd = 4, title = "Comparing palettes mixed from unikn colors", pal_names = c("mix_1", "mix_2", "mix_3"))

# Define a second set of custom palettes from the RColorBrewer and yarrr packages
brew_mix <- usecol(c(rev(brewer.pal(n = 4, name = "Reds")), "white", brewer.pal(n = 4, name = "Blues")), n = 13)
brew_ext <- usecol(brewer.pal(n = 11, name = "Spectral"), n = 12)
yarrr_mix <- usecol(c(piratepal("nemo"), piratepal("bugs")))
yarrr_mod <- usecol(c(piratepal("ipod")), n = 9)

# Display the second set of custom palettes
seecol(pal = list(brew_mix, brew_ext, yarrr_mix, yarrr_mod), col_brd = "white", lwd_brd = 2, title = "Using usecol() and seecol() to mix and modify palettes", pal_names = c("brew_mix", "brew_ext", "yarrr_mix", "yarrr_mod"))

# Define additional custom palettes from the scales package
natjournals_palette <- pal_npg("nrc")(10)

- Log Session Info

Finally, we log the session information for reproducibility.

# Write the session information to a text file
writeLines(capture.output(sessionInfo()), file.path(script_folder, 'Panel_A_SessionInfo.txt'))

# Print the session information
sessionInfo()
## R version 4.3.2 (2023-10-31)
## Platform: aarch64-apple-darwin20 (64-bit)
## Running under: macOS Sonoma 14.3.1
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: Europe/London
## tzcode source: internal
## 
## attached base packages:
## [1] grid      stats     graphics  grDevices utils     datasets  methods  
## [8] base     
## 
## other attached packages:
##  [1] ggsci_3.0.0            scales_1.3.0           yarrr_0.1.5           
##  [4] circlize_0.4.16        BayesFactor_0.9.12-4.7 Matrix_1.6-5          
##  [7] coda_0.19-4.1          jpeg_0.1-10            RColorBrewer_1.1-3    
## [10] unikn_0.9.0            ComplexHeatmap_2.18.0  stringr_1.5.1         
## 
## loaded via a namespace (and not attached):
##  [1] gtable_0.3.4        shape_1.4.6         rjson_0.2.21       
##  [4] xfun_0.43           bslib_0.7.0         ggplot2_3.5.0      
##  [7] GlobalOptions_0.1.2 lattice_0.21-9      vctrs_0.6.5        
## [10] tools_4.3.2         generics_0.1.3      stats4_4.3.2       
## [13] parallel_4.3.2      tibble_3.2.1        fansi_1.0.6        
## [16] highr_0.10          cluster_2.1.4       pkgconfig_2.0.3    
## [19] S4Vectors_0.40.2    lifecycle_1.0.4     compiler_4.3.2     
## [22] MatrixModels_0.5-3  munsell_0.5.0       codetools_0.2-19   
## [25] clue_0.3-65         htmltools_0.5.8     sass_0.4.9         
## [28] yaml_2.3.8          pillar_1.9.0        crayon_1.5.2       
## [31] jquerylib_0.1.4     cachem_1.0.8        iterators_1.0.14   
## [34] foreach_1.5.2       tidyselect_1.2.1    digest_0.6.35      
## [37] mvtnorm_1.2-4       stringi_1.8.3       dplyr_1.1.4        
## [40] bookdown_0.39       rmdformats_1.0.4    fastmap_1.1.1      
## [43] colorspace_2.1-0    cli_3.6.2           magrittr_2.0.3     
## [46] utf8_1.2.4          rmarkdown_2.26      matrixStats_1.2.0  
## [49] png_0.1-8           GetoptLong_1.0.5    pbapply_1.7-2      
## [52] evaluate_0.23       knitr_1.45          IRanges_2.36.0     
## [55] doParallel_1.0.17   rlang_1.1.3         Rcpp_1.0.12        
## [58] glue_1.7.0          BiocManager_1.30.22 BiocGenerics_0.48.1
## [61] rstudioapi_0.16.0   jsonlite_1.8.8      R6_2.5.1

2) Loading input files

Here we load two CSV files containing clinical and mutation metadata.

Clinical_metadata <- read.csv(paste(data_folder, '/CHR_BP-CMML_clinical_metadata.csv', sep = ''), row.names = 'Patient.ID')
Mutation_metadata <- read.csv(paste(data_folder, '/CHR_BP-CMML_mutation_metadata.csv', sep = ''), row.names = 'Patient.ID')

3) Heatmap

- Mutation matrix colors

Here we transformsthe Mutation_metadata dataframe by converting numerical data into categorical data (‘MUT’ for ‘1’, and ’’ for ‘0’), then set up color mapping and rectangle drawing functions for heatmap visualization.

# Loop over all columns in Mutation_metadata
for (colname in colnames(Mutation_metadata)) {
  # Convert the column to character
  Mutation_metadata[,colname] <- as.character(Mutation_metadata[,colname])
  # Replace '1' with 'MUT'
  Mutation_metadata[,colname] <- str_replace_all(Mutation_metadata[,colname], pattern = '1', replacement = 'MUT')
  # Replace '0' with ''
  Mutation_metadata[,colname] <- str_replace_all(Mutation_metadata[,colname], pattern = '0', replacement = '')
}

# Define a color mapping
col = c("MUT" = "grey25")

# Define a list of functions for drawing rectangles
alter_fun = list(
  # Function for drawing a light grey rectangle
  background = function(x, y, w, h) {
    grid.rect(x, y, w-unit(2, "pt"), h-unit(2, "pt"), 
              gp = gpar(fill = "grey93", col = NA))
  },
  # Function for drawing a rectangle with the color defined for 'MUT'
  MUT = function(x, y, w, h) {
    grid.rect(x, y, w-unit(2, "pt"), h-unit(2, "pt"), 
              gp = gpar(fill = col["MUT"], col = NA))
  }
)

# Define an empty column title
column_title = ""

# Define parameters for the heatmap legend
heatmap_legend_param = list(title = "Alternations", at = c("MUT"), 
                            labels = c("Mutation"))

- Selecting relevant clinical metadata for visualisation

Here we subsets ‘Clinical_metadata’ to keep relevant features.

# Subset Clinical_metadata to keep only certain columns
Clinical_metadata_selected <- Clinical_metadata[,c('Cutaneous.BPDCN', 
                                                   'ICC.classification',
                                                   'Cytogenetics.CPSS',
                                                   'Treatment.response',
                                                   'Upfront.HMA',
                                                   'Gender')]

# Subset Mutation_metadata to keep only the rows that have the same row names as Clinical_metadata_selected
Mutation_metadata <- Mutation_metadata[rownames(Clinical_metadata_selected),]

- Defining categories and levels order

Here we convert several columns in Clinical_metadata_selected to factors with specific levels. We then rename the columns of ‘Clinical_metadata_selected’.

# Convert 'Cutaneous.BPDCN' to a factor with levels 'No' and 'Yes'
Clinical_metadata_selected$Cutaneous.BPDCN <- factor(Clinical_metadata_selected$Cutaneous.BPDCN, 
                                                     levels = c('No', 'Yes'))

# Convert 'ICC.classification' to a factor with specific levels
Clinical_metadata_selected$ICC.classification <- factor(Clinical_metadata_selected$ICC.classification, 
                                                        levels = c('BPDCN',
                                                                   'AML not otherwise specified',
                                                                   'AML with CEBPA',
                                                                   'AML with NPM1',
                                                                   'AML with MDS-related gene mutations',
                                                                   'AML with MDS-related cytogenetic abnormalities'))

# Convert 'Cytogenetics.CPSS' to a factor with levels 'Low risk', 'Intermediate risk', and 'High risk'
Clinical_metadata_selected$Cytogenetics.CPSS <- factor(Clinical_metadata_selected$Cytogenetics.CPSS, 
                                                       levels = c('Low risk',
                                                                  'Intermediate risk',
                                                                  'High risk'))

# Convert 'Treatment.response' to a factor with levels 'CR', 'Refractory', and 'Not evaluable'
Clinical_metadata_selected$Treatment.response <- factor(Clinical_metadata_selected$Treatment.response, 
                                                        levels = c('CR',
                                                                   'Refractory',
                                                                   'Not evaluable'))

# Convert 'Upfront.HMA' to a factor with levels 'No' and 'Yes'
Clinical_metadata_selected$Upfront.HMA <- factor(Clinical_metadata_selected$Upfront.HMA, 
                                                 levels = c('No',
                                                            'Yes'))

# Convert 'Gender' to a factor with levels 'Female' and 'Male'
Clinical_metadata_selected$Gender <- factor(Clinical_metadata_selected$Gender, 
                                            levels = c('Female',
                                                       'Male'))

# Rename the columns of Clinical_metadata_selected
colnames(Clinical_metadata_selected) <- c('Cutaneous BPDCN', 
                                          'ICC classification', 
                                          'Cytogenetics (CPSS)',
                                          'Treatment response', 
                                          'Upfront HMA', 
                                          'Gender')

- Heatmap columns metadata annotation colour

Here we define a list of color mappings for different categories in several variables.

# Define a list of color mappings for different categories in several variables
colors_top_annotation <-  list(
  `Cutaneous BPDCN` = c('Yes' = '#b5179e', 
                        'No' = '#ffd2fc'),
  `ICC classification` = c('BPDCN' = '#fff0f3',
                           'AML not otherwise specified' = '#ffccd5',
                           'AML with CEBPA' = '#ff8fa3',
                           'AML with NPM1' = '#ff4d6d',
                           'AML with MDS-related gene mutations' = '#c9184a',
                           'AML with MDS-related cytogenetic abnormalities' = '#800f2f'),
  `Cytogenetics (CPSS)` = c('Low risk' = '#ffdcc2',
                            'Intermediate risk' = '#eda268',
                            'High risk' = '#522500'),
  `Treatment response` = c('CR' = '#e9f5db',
                           'Refractory' = '#c2d5aa',
                           'Not evaluable' = '#606f49'),
  `Upfront HMA` = c('Yes' = '#72bbce', 
                    'No' = '#dceef3'),
  Gender = c('Male' = '#e1e5f2', 
             'Female' = '#bee3db')
)

- Columns annotation

Here we create a heatmap annotation.

# Create a heatmap annotation object
ha <- HeatmapAnnotation(
  df = Clinical_metadata_selected, 
  gp = gpar(lwd = 2, col = 'white'),
  col = colors_top_annotation, 
  show_annotation_name = TRUE, 
  annotation_name_side = "left",
  show_legend = TRUE,
  annotation_name_gp = gpar(fontsize = 12, fontfamily = 'sans', fontface = 'bold'), 
  annotation_legend_param = list(
    `Cutaneous BPDCN` = list(direction = "horizontal"),
    `ICC classification` = list(direction = "vertical"),
    `Cytogenetics (CPSS)` = list(direction = "vertical"),
    `Treatment response` = list(direction = "vertical"),
    `Upfront HMA` = list(direction = "horizontal"),
    `Gender` = list(direction = "horizontal")
  )
)

- Heatmap styling

Here we set custom padding for the column and row annotations in a heatmap.

# Set the padding for the column annotations to 0.4 cm
ht_opt$COLUMN_ANNO_PADDING = unit(0.4, "cm")

# Set the padding for the row annotations to 0.4 cm
ht_opt$ROW_ANNO_PADDING = unit(0.4, "cm")

- Heatmap plotting

Here we create an oncoprint, which is a type of heatmap used in genomics to visualize gene mutations across multiple samples.

# Create an oncoprint
oncoPrint_with_legend <- oncoPrint(t(Mutation_metadata),
                                   alter_fun = alter_fun, 
                                   alter_fun_is_vectorized = FALSE, 
                                   col = col, 
                                   remove_empty_columns = TRUE, 
                                   remove_empty_rows = TRUE,
                                   pct_side = "right", border = FALSE,
                                   row_names_side = "left",
                                   top_annotation = ha,
                                   pct_gp = gpar(fontsize = 12, fontfamily = 'sans'),
                                   row_names_gp = gpar(fontsize = 12, fontfamily = 'sans'),
                                   right_annotation =  rowAnnotation(rbar = anno_oncoprint_barplot()),
                                   left_annotation = NULL, show_heatmap_legend = TRUE,
                                   bottom_annotation =  columnAnnotation(botbar = anno_oncoprint_barplot(axis_param = list(direction = "reverse"))),
                                   column_title = column_title)
## All mutation types: MUT.
# Now we save our plot:

# Open a new PNG device for plotting
png(filename = paste(output_folder, '/CHR_BP-CMML_Patients__Oncoprint.png', sep = ''), units = 'cm', width = 35, height = 22, res = 300)

# Draw the oncoprint on the current plotting device
draw(oncoPrint_with_legend, heatmap_legend_side = "right", annotation_legend_side = "right")

# Add text to the "rbar" annotation
decorate_annotation("rbar", {
  grid.text("Number of\nmutations\nin cohort", x = unit(10, "mm"), y = unit(165, "mm"), rot = 0, just = "bottom")
})

# Add text to the "botbar" annotation
decorate_annotation("botbar", {
  grid.text("Number of\nmutations\nin patient", x = unit(-9, "mm"), y = unit(10, "mm"), rot = 90, just = "bottom")
})

# Close the current plotting device
dev.off()
## quartz_off_screen 
##                 2

- Plotting final result

# Display the oncoprint

knitr::include_graphics(paste(output_folder, '/CHR_BP-CMML_Patients__Oncoprint.png', sep = ''))
Figure 1A

Figure 1A

Chapter 2

## Warning: `includeHTML()` was provided a `path` that appears to be a complete HTML document.
## ✖ Path: /Users/kgurashi/GitHub/2024__CRM__BP-CMML_Manuscript/Scripts/Figure_01/Panel_A_copy.html
## ℹ Use `tags$iframe()` to include an HTML document. You can either ensure `path` is accessible in your app or document (see e.g. `shiny::addResourcePath()`) and pass the relative path to the `src` argument. Or you can read the contents of `path` and pass the contents to `srcdoc`.
Figure 01 - Panel A

Figure 01 - Panel A

1) Setup

- Defining work directory

In this section, we define the working directory for the R Markdown document.

# Get the path of the current script
# Then get the parent directory of the parent directory of the parent directory
local_wd_folder <- dirname(dirname(dirname(rstudioapi::getSourceEditorContext()$path)))

# Set the root directory for knitr to the local working directory
knitr::opts_knit$set(root.dir = local_wd_folder)

- Defining input data and output directories

Here, we define the directories for input data and output files.

# Get the directory of the current script
script_folder <- dirname(rstudioapi::getSourceEditorContext()$path)

# Define the data folder and output folder
data_folder <- './Data/Figure_01'
output_folder <- './Figures/Figure_01'

- Setting seed

Setting a seed ensures that any random processes are reproducible.

# Set a seed for reproducibility
set.seed(123)

- Packages installation (optional)

In this section, we ensure that all necessary packages are installed.

# Ensure BiocManager is available for installation of Bioconductor packages
if (!requireNamespace("BiocManager", quietly = TRUE)) install.packages("BiocManager")

# Define a list of required packages used in this script
packages_required <- c("ComplexHeatmap", "stringr", 
                        "unikn", "RColorBrewer", "yarrr", 
                        "scales", "ggsci")

# Identify any required packages that are not installed
packages_uninstalled <- packages_required[!(packages_required %in% installed.packages()[,"Package"])]

# Install any uninstalled packages
if(length(packages_uninstalled)) BiocManager::install(packages_uninstalled)

- Loading packages

Here, we load the necessary packages for our analysis.

# Load stringr for string manipulation
library(stringr, quietly = TRUE)

# Load ComplexHeatmap for creating complex heatmaps
library(ComplexHeatmap, quietly = TRUE)

- Loading palettes

In this section, we load additional color palettes and define some custom ones.

# Load additional colour palette packages
library(unikn, quietly = TRUE)
library(RColorBrewer, quietly = TRUE)
library(yarrr, quietly = TRUE)
library(scales, quietly = TRUE)
library(ggsci, quietly = TRUE)

# Define a set of custom color palettes from the unikn package
mix_1 <- usecol(pal = c(Karpfenblau, "white", Peach), n = 15)
mix_2 <- usecol(pal = c(rev(pal_seeblau), "white", pal_pinky))
mix_3 <- usecol(pal = c(rev(pal_bordeaux), "white", pal_petrol), n = 15)

# Display the custom palettes
seecol(list(mix_1, mix_2, mix_3), col_brd = "white", lwd_brd = 4, title = "Comparing palettes mixed from unikn colors", pal_names = c("mix_1", "mix_2", "mix_3"))

# Define a second set of custom palettes from the RColorBrewer and yarrr packages
brew_mix <- usecol(c(rev(brewer.pal(n = 4, name = "Reds")), "white", brewer.pal(n = 4, name = "Blues")), n = 13)
brew_ext <- usecol(brewer.pal(n = 11, name = "Spectral"), n = 12)
yarrr_mix <- usecol(c(piratepal("nemo"), piratepal("bugs")))
yarrr_mod <- usecol(c(piratepal("ipod")), n = 9)

# Display the second set of custom palettes
seecol(pal = list(brew_mix, brew_ext, yarrr_mix, yarrr_mod), col_brd = "white", lwd_brd = 2, title = "Using usecol() and seecol() to mix and modify palettes", pal_names = c("brew_mix", "brew_ext", "yarrr_mix", "yarrr_mod"))

# Define additional custom palettes from the scales package
natjournals_palette <- pal_npg("nrc")(10)

- Log Session Info

Finally, we log the session information for reproducibility.

# Write the session information to a text file
writeLines(capture.output(sessionInfo()), file.path(script_folder, 'Panel_A_SessionInfo.txt'))

# Print the session information
sessionInfo()
## R version 4.3.2 (2023-10-31)
## Platform: aarch64-apple-darwin20 (64-bit)
## Running under: macOS Sonoma 14.3.1
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: Europe/London
## tzcode source: internal
## 
## attached base packages:
## [1] grid      stats     graphics  grDevices utils     datasets  methods  
## [8] base     
## 
## other attached packages:
##  [1] ggsci_3.0.0            scales_1.3.0           yarrr_0.1.5           
##  [4] circlize_0.4.16        BayesFactor_0.9.12-4.7 Matrix_1.6-5          
##  [7] coda_0.19-4.1          jpeg_0.1-10            RColorBrewer_1.1-3    
## [10] unikn_0.9.0            ComplexHeatmap_2.18.0  stringr_1.5.1         
## 
## loaded via a namespace (and not attached):
##  [1] gtable_0.3.4        shape_1.4.6         rjson_0.2.21       
##  [4] xfun_0.43           bslib_0.7.0         ggplot2_3.5.0      
##  [7] GlobalOptions_0.1.2 lattice_0.21-9      vctrs_0.6.5        
## [10] tools_4.3.2         generics_0.1.3      stats4_4.3.2       
## [13] parallel_4.3.2      tibble_3.2.1        fansi_1.0.6        
## [16] highr_0.10          cluster_2.1.4       pkgconfig_2.0.3    
## [19] S4Vectors_0.40.2    lifecycle_1.0.4     compiler_4.3.2     
## [22] MatrixModels_0.5-3  munsell_0.5.0       codetools_0.2-19   
## [25] clue_0.3-65         htmltools_0.5.8     sass_0.4.9         
## [28] yaml_2.3.8          pillar_1.9.0        crayon_1.5.2       
## [31] jquerylib_0.1.4     cachem_1.0.8        iterators_1.0.14   
## [34] foreach_1.5.2       tidyselect_1.2.1    digest_0.6.35      
## [37] mvtnorm_1.2-4       stringi_1.8.3       dplyr_1.1.4        
## [40] bookdown_0.39       rmdformats_1.0.4    fastmap_1.1.1      
## [43] colorspace_2.1-0    cli_3.6.2           magrittr_2.0.3     
## [46] utf8_1.2.4          rmarkdown_2.26      matrixStats_1.2.0  
## [49] png_0.1-8           GetoptLong_1.0.5    pbapply_1.7-2      
## [52] evaluate_0.23       knitr_1.45          IRanges_2.36.0     
## [55] doParallel_1.0.17   rlang_1.1.3         Rcpp_1.0.12        
## [58] glue_1.7.0          BiocManager_1.30.22 BiocGenerics_0.48.1
## [61] rstudioapi_0.16.0   jsonlite_1.8.8      R6_2.5.1

2) Loading input files

Here we load two CSV files containing clinical and mutation metadata.

Clinical_metadata <- read.csv(paste(data_folder, '/CHR_BP-CMML_clinical_metadata.csv', sep = ''), row.names = 'Patient.ID')
Mutation_metadata <- read.csv(paste(data_folder, '/CHR_BP-CMML_mutation_metadata.csv', sep = ''), row.names = 'Patient.ID')

3) Heatmap

- Mutation matrix colors

Here we transformsthe Mutation_metadata dataframe by converting numerical data into categorical data (‘MUT’ for ‘1’, and ’’ for ‘0’), then set up color mapping and rectangle drawing functions for heatmap visualization.

# Loop over all columns in Mutation_metadata
for (colname in colnames(Mutation_metadata)) {
  # Convert the column to character
  Mutation_metadata[,colname] <- as.character(Mutation_metadata[,colname])
  # Replace '1' with 'MUT'
  Mutation_metadata[,colname] <- str_replace_all(Mutation_metadata[,colname], pattern = '1', replacement = 'MUT')
  # Replace '0' with ''
  Mutation_metadata[,colname] <- str_replace_all(Mutation_metadata[,colname], pattern = '0', replacement = '')
}

# Define a color mapping
col = c("MUT" = "grey25")

# Define a list of functions for drawing rectangles
alter_fun = list(
  # Function for drawing a light grey rectangle
  background = function(x, y, w, h) {
    grid.rect(x, y, w-unit(2, "pt"), h-unit(2, "pt"), 
              gp = gpar(fill = "grey93", col = NA))
  },
  # Function for drawing a rectangle with the color defined for 'MUT'
  MUT = function(x, y, w, h) {
    grid.rect(x, y, w-unit(2, "pt"), h-unit(2, "pt"), 
              gp = gpar(fill = col["MUT"], col = NA))
  }
)

# Define an empty column title
column_title = ""

# Define parameters for the heatmap legend
heatmap_legend_param = list(title = "Alternations", at = c("MUT"), 
                            labels = c("Mutation"))

- Selecting relevant clinical metadata for visualisation

Here we subsets ‘Clinical_metadata’ to keep relevant features.

# Subset Clinical_metadata to keep only certain columns
Clinical_metadata_selected <- Clinical_metadata[,c('Cutaneous.BPDCN', 
                                                   'ICC.classification',
                                                   'Cytogenetics.CPSS',
                                                   'Treatment.response',
                                                   'Upfront.HMA',
                                                   'Gender')]

# Subset Mutation_metadata to keep only the rows that have the same row names as Clinical_metadata_selected
Mutation_metadata <- Mutation_metadata[rownames(Clinical_metadata_selected),]

- Defining categories and levels order

Here we convert several columns in Clinical_metadata_selected to factors with specific levels. We then rename the columns of ‘Clinical_metadata_selected’.

# Convert 'Cutaneous.BPDCN' to a factor with levels 'No' and 'Yes'
Clinical_metadata_selected$Cutaneous.BPDCN <- factor(Clinical_metadata_selected$Cutaneous.BPDCN, 
                                                     levels = c('No', 'Yes'))

# Convert 'ICC.classification' to a factor with specific levels
Clinical_metadata_selected$ICC.classification <- factor(Clinical_metadata_selected$ICC.classification, 
                                                        levels = c('BPDCN',
                                                                   'AML not otherwise specified',
                                                                   'AML with CEBPA',
                                                                   'AML with NPM1',
                                                                   'AML with MDS-related gene mutations',
                                                                   'AML with MDS-related cytogenetic abnormalities'))

# Convert 'Cytogenetics.CPSS' to a factor with levels 'Low risk', 'Intermediate risk', and 'High risk'
Clinical_metadata_selected$Cytogenetics.CPSS <- factor(Clinical_metadata_selected$Cytogenetics.CPSS, 
                                                       levels = c('Low risk',
                                                                  'Intermediate risk',
                                                                  'High risk'))

# Convert 'Treatment.response' to a factor with levels 'CR', 'Refractory', and 'Not evaluable'
Clinical_metadata_selected$Treatment.response <- factor(Clinical_metadata_selected$Treatment.response, 
                                                        levels = c('CR',
                                                                   'Refractory',
                                                                   'Not evaluable'))

# Convert 'Upfront.HMA' to a factor with levels 'No' and 'Yes'
Clinical_metadata_selected$Upfront.HMA <- factor(Clinical_metadata_selected$Upfront.HMA, 
                                                 levels = c('No',
                                                            'Yes'))

# Convert 'Gender' to a factor with levels 'Female' and 'Male'
Clinical_metadata_selected$Gender <- factor(Clinical_metadata_selected$Gender, 
                                            levels = c('Female',
                                                       'Male'))

# Rename the columns of Clinical_metadata_selected
colnames(Clinical_metadata_selected) <- c('Cutaneous BPDCN', 
                                          'ICC classification', 
                                          'Cytogenetics (CPSS)',
                                          'Treatment response', 
                                          'Upfront HMA', 
                                          'Gender')

- Heatmap columns metadata annotation colour

Here we define a list of color mappings for different categories in several variables.

# Define a list of color mappings for different categories in several variables
colors_top_annotation <-  list(
  `Cutaneous BPDCN` = c('Yes' = '#b5179e', 
                        'No' = '#ffd2fc'),
  `ICC classification` = c('BPDCN' = '#fff0f3',
                           'AML not otherwise specified' = '#ffccd5',
                           'AML with CEBPA' = '#ff8fa3',
                           'AML with NPM1' = '#ff4d6d',
                           'AML with MDS-related gene mutations' = '#c9184a',
                           'AML with MDS-related cytogenetic abnormalities' = '#800f2f'),
  `Cytogenetics (CPSS)` = c('Low risk' = '#ffdcc2',
                            'Intermediate risk' = '#eda268',
                            'High risk' = '#522500'),
  `Treatment response` = c('CR' = '#e9f5db',
                           'Refractory' = '#c2d5aa',
                           'Not evaluable' = '#606f49'),
  `Upfront HMA` = c('Yes' = '#72bbce', 
                    'No' = '#dceef3'),
  Gender = c('Male' = '#e1e5f2', 
             'Female' = '#bee3db')
)

- Columns annotation

Here we create a heatmap annotation.

# Create a heatmap annotation object
ha <- HeatmapAnnotation(
  df = Clinical_metadata_selected, 
  gp = gpar(lwd = 2, col = 'white'),
  col = colors_top_annotation, 
  show_annotation_name = TRUE, 
  annotation_name_side = "left",
  show_legend = TRUE,
  annotation_name_gp = gpar(fontsize = 12, fontfamily = 'sans', fontface = 'bold'), 
  annotation_legend_param = list(
    `Cutaneous BPDCN` = list(direction = "horizontal"),
    `ICC classification` = list(direction = "vertical"),
    `Cytogenetics (CPSS)` = list(direction = "vertical"),
    `Treatment response` = list(direction = "vertical"),
    `Upfront HMA` = list(direction = "horizontal"),
    `Gender` = list(direction = "horizontal")
  )
)

- Heatmap styling

Here we set custom padding for the column and row annotations in a heatmap.

# Set the padding for the column annotations to 0.4 cm
ht_opt$COLUMN_ANNO_PADDING = unit(0.4, "cm")

# Set the padding for the row annotations to 0.4 cm
ht_opt$ROW_ANNO_PADDING = unit(0.4, "cm")

- Heatmap plotting

Here we create an oncoprint, which is a type of heatmap used in genomics to visualize gene mutations across multiple samples.

# Create an oncoprint
oncoPrint_with_legend <- oncoPrint(t(Mutation_metadata),
                                   alter_fun = alter_fun, 
                                   alter_fun_is_vectorized = FALSE, 
                                   col = col, 
                                   remove_empty_columns = TRUE, 
                                   remove_empty_rows = TRUE,
                                   pct_side = "right", border = FALSE,
                                   row_names_side = "left",
                                   top_annotation = ha,
                                   pct_gp = gpar(fontsize = 12, fontfamily = 'sans'),
                                   row_names_gp = gpar(fontsize = 12, fontfamily = 'sans'),
                                   right_annotation =  rowAnnotation(rbar = anno_oncoprint_barplot()),
                                   left_annotation = NULL, show_heatmap_legend = TRUE,
                                   bottom_annotation =  columnAnnotation(botbar = anno_oncoprint_barplot(axis_param = list(direction = "reverse"))),
                                   column_title = column_title)
## All mutation types: MUT.
# Now we save our plot:

# Open a new PNG device for plotting
png(filename = paste(output_folder, '/CHR_BP-CMML_Patients__Oncoprint.png', sep = ''), units = 'cm', width = 35, height = 22, res = 300)

# Draw the oncoprint on the current plotting device
draw(oncoPrint_with_legend, heatmap_legend_side = "right", annotation_legend_side = "right")

# Add text to the "rbar" annotation
decorate_annotation("rbar", {
  grid.text("Number of\nmutations\nin cohort", x = unit(10, "mm"), y = unit(165, "mm"), rot = 0, just = "bottom")
})

# Add text to the "botbar" annotation
decorate_annotation("botbar", {
  grid.text("Number of\nmutations\nin patient", x = unit(-9, "mm"), y = unit(10, "mm"), rot = 90, just = "bottom")
})

# Close the current plotting device
dev.off()
## quartz_off_screen 
##                 2

- Plotting final result

# Display the oncoprint

knitr::include_graphics(paste(output_folder, '/CHR_BP-CMML_Patients__Oncoprint.png', sep = ''))
Figure 1A

Figure 1A